home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istan / ANLIB3.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  48.7 KB  |  1,221 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.3
  3. C---------------------------------------------------------
  4. C---------------------------------------------------------
  5. C    TOOLPACK/1    Release: 2.3
  6. C---------------------------------------------------------
  7. C ----------------------------------------------------------------------
  8. C
  9. C       L O A D T S   -   Establish statement type directory entry
  10. C
  11.  
  12.         SUBROUTINE LOADTS(IEXECA,ICODEA)
  13.         INTEGER IEXECA,ICODEA
  14.  
  15. C---------------------------------------------------------
  16. C    TOOLPACK/1    Release: 2.3
  17. C---------------------------------------------------------
  18. C Character variables and arrays, except for dictionaries & VNAMEG
  19.         INTEGER MAXCMG
  20.         PARAMETER(MAXCMG=30)
  21.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  22.  
  23.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  24.         CHARACTER*6 NAMEG
  25.         CHARACTER*72 ICOMG(MAXCMG)
  26.  
  27.         SAVE /CHARC/
  28. C---------------------------------------------------------
  29. C    TOOLPACK/1    Release: 2.3
  30. C---------------------------------------------------------
  31. C                  CONTROL VARIABLES
  32.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  33.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  34.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  35.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  36.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  37.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  38.      *         NSTMG,       NTREEG,      NTYPEG
  39.  
  40.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  41.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  42.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  43.      +          NTREEG,NTYPEG
  44.  
  45.         SAVE /CNTRLC/
  46.  
  47. C---------------------------------------------------------
  48. C    TOOLPACK/1    Release: 2.3
  49. C---------------------------------------------------------
  50. C                  MAIN INTEGER STORAGE ARRAYS
  51. C MAXLBG = Maximum number of DO statement labels per routine
  52.         INTEGER MAXLBG
  53.         PARAMETER(MAXLBG=100)
  54.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  55.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  56.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  57.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  58.      +          KEXECG,LABG,KTOKG
  59.         SAVE /WORKC/
  60.  
  61.         CHARACTER ICHARL
  62.         INTEGER NCHARL,L
  63.  
  64. C Save number of type and position in table
  65.         NTYPEG = NTYPEG + 1
  66.         ICODEA = NTYPEG
  67.         KEXECG(NTYPEG) = IEXECA
  68.  
  69.         END
  70. C ----------------------------------------------------------------------
  71. C
  72. C       N F I N D F   -   Locate a mnemonic in a mnemonic dictionary.
  73. C
  74.  
  75.         INTEGER FUNCTION NFINDF(NAMEA,IARYA,IDIMA)
  76.         CHARACTER*6 IARYA(*),NAMEA
  77.         INTEGER IDIMA
  78.  
  79.         INTEGER L
  80.  
  81.         NFINDF=0
  82.         DO 100 L=1,IDIMA
  83.             IF (NAMEA.EQ.IARYA(L)) THEN
  84.                 NFINDF = L
  85.                 RETURN
  86.             END IF
  87.   100   CONTINUE
  88.  
  89.         END
  90. C ----------------------------------------------------------------------
  91. C
  92. C       N S A V E S   -   Ensure a name is saved in a dictionary,
  93. C                         returning its location in the dictionary.
  94. C
  95.  
  96.         SUBROUTINE NSAVES(NAMEA,IARYA,NUMA,MAXA,LOCA)
  97.         CHARACTER*6 IARYA(*),NAMEA
  98.         INTEGER NUMA,MAXA,LOCA
  99.  
  100.         INTEGER LOCL
  101.  
  102.         INTEGER NFINDF
  103.  
  104. C Is mnemonic already in dictionary?
  105.         LOCL = NFINDF(NAMEA,IARYA,NUMA)
  106.         IF (LOCL.NE.0) THEN
  107. C Mnemonic in dictionary
  108.             LOCA = LOCL
  109.         ELSE
  110. C Mnemonic not in dictionary
  111.             IF (NUMA.LT.MAXA) THEN
  112. C Add to dictionary
  113.                 NUMA = NUMA + 1
  114.                 IARYA(NUMA) = NAMEA
  115.                 LOCA = NUMA
  116.             ELSE
  117. C Dictionary overflow
  118.                 LOCA = 0
  119.             END IF
  120.         END IF
  121.  
  122.         END
  123. C ----------------------------------------------------------------------
  124. C
  125. C       O U T S   -   Control output of normal statement annotation
  126. C                     and instrumentation
  127. C
  128.  
  129.         SUBROUTINE OUTS
  130.  
  131. C---------------------------------------------------------
  132. C    TOOLPACK/1    Release: 2.3
  133. C---------------------------------------------------------
  134. C Character variables and arrays, except for dictionaries & VNAMEG
  135.         INTEGER MAXCMG
  136.         PARAMETER(MAXCMG=30)
  137.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  138.  
  139.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  140.         CHARACTER*6 NAMEG
  141.         CHARACTER*72 ICOMG(MAXCMG)
  142.  
  143.         SAVE /CHARC/
  144. C---------------------------------------------------------
  145. C    TOOLPACK/1    Release: 2.3
  146. C---------------------------------------------------------
  147. C                  LOGICAL VARIABLES
  148.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  149.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  150.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  151.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  152.      *         TREEG
  153.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  154.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  155.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  156.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  157.  
  158.         SAVE /LOGIC/
  159.  
  160. C---------------------------------------------------------
  161. C    TOOLPACK/1    Release: 2.3
  162. C---------------------------------------------------------
  163. C                  CONTROL VARIABLES
  164.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  165.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  166.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  167.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  168.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  169.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  170.      *         NSTMG,       NTREEG,      NTYPEG
  171.  
  172.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  173.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  174.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  175.      +          NTREEG,NTYPEG
  176.  
  177.         SAVE /CNTRLC/
  178.  
  179. C---------------------------------------------------------
  180. C    TOOLPACK/1    Release: 2.3
  181. C---------------------------------------------------------
  182. C                  KEYWORD ID VARIABLES
  183.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  184.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  185.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  186.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  187.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  188.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  189.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  190.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  191.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  192.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  193.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  194.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  195.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  196.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  197.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  198.      *         LLINEG,      LSTMTG
  199.  
  200.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  201.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  202.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  203.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  204.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  205.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  206.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  207.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  208.         INTEGER KUFUNG,KSUBRG
  209.  
  210.         SAVE /KEYSC/
  211.  
  212. C---------------------------------------------------------
  213. C    TOOLPACK/1    Release: 2.3
  214. C---------------------------------------------------------
  215. C                  MAIN INTEGER STORAGE ARRAYS
  216. C MAXLBG = Maximum number of DO statement labels per routine
  217.         INTEGER MAXLBG
  218.         PARAMETER(MAXLBG=100)
  219.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  220.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  221.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  222.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  223.      +          KEXECG,LABG,KTOKG
  224.         SAVE /WORKC/
  225. C---------------------------------------------------------
  226. C    TOOLPACK/1    Release: 2.3
  227. C---------------------------------------------------------
  228.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  229.      +                MAXICH
  230.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  231.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  232.      +          MAXICH
  233.  
  234.         SAVE /TOKENS/
  235.  
  236. C
  237. C TOKTYP = array of token types for current statement
  238. C TOKLEN = parallel array of lengths of associated text strings
  239. C TXTPTR = parallel array of pointers into ISTMG character array of text
  240. C TOKEN = Current token number within statement being processed
  241. C NTOKSS = Number of tokens in statement
  242. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  243. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  244. C MAXICH = Last character used in ISTTXT array
  245. C
  246.  
  247.         IF (KEXECG(ITYPEG).EQ.1) THEN
  248. C This statement is executable
  249.             IF (LABFLG.EQ.2 .AND. SEGMTG .AND. ITYPEG.NE.KCONTG) THEN
  250. C This statement ends an active DO-loop
  251.                 CALL OUTDOS
  252.                 CALL SENDTK(2,NTOKSS)
  253.                 CALL SEND
  254.                 CALL OUTANS(NMSEG)
  255.             ELSE
  256. C This statement does not end a do-loop, ends an inactive DO-loop,
  257. C or is a 'CONTINUE' statement which ends an active DO-loop.
  258.                 IF (SEGMTG) THEN
  259. C This statement starts a segment - output segment instrumentation.
  260.                     CALL OUTSGS(NMSEG)
  261. C Output annotation
  262.                     CALL OUTANS(NMSEG)
  263. C If not a CONTINUE, output instrumented statement ...
  264. C But remove label first (if any)
  265.                     IF (LABFLG.NE.0) CALL UNLABL
  266.                     IF (ITYPEG.NE.KCONTG) CALL INSOUT
  267.                 ELSE
  268. C Executable statement, but no segment required
  269.                     CALL OUTANS(0)
  270.                     CALL INSOUT
  271.                 END IF
  272.             END IF
  273.         ELSE
  274. C Non-executable statement
  275.             IF (LTYPEG.EQ.KENDG .AND. SEGMTG) THEN
  276. C First segment of routine
  277.                 CALL OUTANS(NMSEG)
  278.             ELSE
  279. C Not first segment of routine
  280.                 CALL OUTANS(0)
  281.             END IF
  282.             CALL INSOUT
  283.         END IF
  284.  
  285.         END
  286. C ----------------------------------------------------------------------
  287. C
  288. C       O U T A N S   -   Output statement to annotated listing
  289. C
  290.  
  291.         SUBROUTINE OUTANS(NSEGA)
  292.         INTEGER NSEGA
  293.  
  294. C---------------------------------------------------------
  295. C    TOOLPACK/1    Release: 2.4
  296. C---------------------------------------------------------
  297. C
  298. C  TKLAST = LAST TOKEN NUMBER
  299. C
  300.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  301.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  302.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  303.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  304.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  305.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  306.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  307.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  308.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  309.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  310.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  311.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  312.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  313.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  314.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  315.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  316.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  317.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  318.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  319.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  320.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  321.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  322.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  323.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  324.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  325.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  326.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  327.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  328.  
  329. C---------------------------------------------------------
  330. C    TOOLPACK/1    Release: 2.3
  331. C---------------------------------------------------------
  332.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  333.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  334.  
  335.         SAVE /IO/
  336.  
  337. C---------------------------------------------------------
  338. C    TOOLPACK/1    Release: 2.3
  339. C---------------------------------------------------------
  340.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  341.      +                MAXICH
  342.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  343.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  344.      +          MAXICH
  345.  
  346.         SAVE /TOKENS/
  347.  
  348. C
  349. C TOKTYP = array of token types for current statement
  350. C TOKLEN = parallel array of lengths of associated text strings
  351. C TXTPTR = parallel array of pointers into ISTMG character array of text
  352. C TOKEN = Current token number within statement being processed
  353. C NTOKSS = Number of tokens in statement
  354. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  355. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  356. C MAXICH = Last character used in ISTTXT array
  357. C
  358.  
  359.         INTEGER I
  360.  
  361.         CHARACTER*5 SEGNUM
  362.  
  363. C Convert segment number to characters
  364.         IF (NSEGA.NE.0) THEN
  365.             WRITE(SEGNUM,9000) NSEGA
  366.             CALL WRITOK(TCMMNT,'*$AN$'//SEGNUM)
  367.         END IF
  368.         DO 100 I=1,NTOKSS
  369.  100        CALL ZTOKWR(TOKTYP(I),TOKLEN(I),ISTTXT(ISTPTR(I)),
  370.      +                  TKODES)
  371.  
  372. 9000    FORMAT(SS,I5)
  373.         END
  374. C ----------------------------------------------------------------------
  375. C
  376. C       O U T D O S   -   Output segment for DO-loop ending statement
  377. C
  378.  
  379.         SUBROUTINE OUTDOS
  380.  
  381. C---------------------------------------------------------
  382. C    TOOLPACK/1    Release: 2.3
  383. C---------------------------------------------------------
  384. C                  CONTROL VARIABLES
  385.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  386.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  387.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  388.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  389.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  390.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  391.      *         NSTMG,       NTREEG,      NTYPEG
  392.  
  393.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  394.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  395.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  396.      +          NTREEG,NTYPEG
  397.  
  398.         SAVE /CNTRLC/
  399.  
  400. C---------------------------------------------------------
  401. C    TOOLPACK/1    Release: 2.3
  402. C---------------------------------------------------------
  403. C                  ROUTINE INSTRUMENTATION FLAGS
  404.       COMMON / INSTC   /    INST1G,      INST2G,      INST3G
  405.  
  406.         INTEGER INST1G,INST2G,INST3G
  407.  
  408.         SAVE /INSTC/
  409.  
  410. C---------------------------------------------------------
  411. C    TOOLPACK/1    Release: 2.3
  412. C---------------------------------------------------------
  413. C                  LOGICAL VARIABLES
  414.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  415.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  416.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  417.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  418.      *         TREEG
  419.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  420.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  421.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  422.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  423.  
  424.         SAVE /LOGIC/
  425.  
  426. C---------------------------------------------------------
  427. C    TOOLPACK/1    Release: 2.3
  428. C---------------------------------------------------------
  429.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  430.      +                MAXICH
  431.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  432.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  433.      +          MAXICH
  434.  
  435.         SAVE /TOKENS/
  436.  
  437. C
  438. C TOKTYP = array of token types for current statement
  439. C TOKLEN = parallel array of lengths of associated text strings
  440. C TXTPTR = parallel array of pointers into ISTMG character array of text
  441. C TOKEN = Current token number within statement being processed
  442. C NTOKSS = Number of tokens in statement
  443. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  444. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  445. C MAXICH = Last character used in ISTTXT array
  446. C
  447. C---------------------------------------------------------
  448. C    TOOLPACK/1    Release: 2.3
  449. C---------------------------------------------------------
  450.         COMMON/ANVNAM/VNAMEG
  451.         CHARACTER*5 VNAMEG
  452.         SAVE/ANVNAM/
  453.  
  454.         IFDOG = .TRUE.
  455.         INST3G = 1
  456.         CALL SENDTK(1,1)
  457.         CALL SENDCH('IF(L'//VNAMEG//'(.TRUE.,')
  458.         CALL SENDI(NMSEG)
  459.         CALL SENDCH(',0))')
  460.  
  461.         END
  462. C ----------------------------------------------------------------------
  463. C
  464. C       O U T I F S   -   Output annotated IF statements
  465. C
  466.  
  467.         SUBROUTINE OUTIFS(ISEGA,JSEGA)
  468.         INTEGER ISEGA,JSEGA
  469.  
  470. C---------------------------------------------------------
  471. C    TOOLPACK/1    Release: 2.3
  472. C---------------------------------------------------------
  473. C                  CONTROL VARIABLES
  474.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  475.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  476.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  477.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  478.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  479.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  480.      *         NSTMG,       NTREEG,      NTYPEG
  481.  
  482.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  483.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  484.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  485.      +          NTREEG,NTYPEG
  486.  
  487.         SAVE /CNTRLC/
  488.  
  489. C---------------------------------------------------------
  490. C    TOOLPACK/1    Release: 2.4
  491. C---------------------------------------------------------
  492. C
  493. C  TKLAST = LAST TOKEN NUMBER
  494. C
  495.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  496.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  497.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  498.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  499.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  500.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  501.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  502.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  503.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  504.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  505.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  506.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  507.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  508.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  509.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  510.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  511.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  512.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  513.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  514.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  515.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  516.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  517.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  518.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  519.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  520.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  521.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  522.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  523.  
  524.  
  525.         CHARACTER*5 ISEG,JSEG
  526.  
  527.         IF (ISEGA.NE.0) THEN
  528.             WRITE(ISEG,9000) ISEGA
  529.         ELSE
  530.             ISEG=' '
  531.         END IF
  532.         WRITE(JSEG,9000) JSEGA
  533.         CALL WRITOK(TCMMNT,'*$AN$'//ISEG//'      '//JSEG)
  534.         CALL OUTANS(0)
  535.  
  536. 9000    FORMAT(SS,I5)
  537.         END
  538. C ----------------------------------------------------------------------
  539. C
  540. C       O U T S G S   -   Output a normal segment
  541. C
  542.  
  543.         SUBROUTINE OUTSGS(NMSEGA)
  544.         INTEGER NMSEGA
  545.  
  546. C---------------------------------------------------------
  547. C    TOOLPACK/1    Release: 2.3
  548. C---------------------------------------------------------
  549.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  550.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  551.  
  552.         SAVE /IO/
  553.  
  554. C---------------------------------------------------------
  555. C    TOOLPACK/1    Release: 2.3
  556. C---------------------------------------------------------
  557. C                  LOGICAL VARIABLES
  558.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  559.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  560.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  561.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  562.      *         TREEG
  563.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  564.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  565.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  566.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  567.  
  568.         SAVE /LOGIC/
  569.  
  570. C---------------------------------------------------------
  571. C    TOOLPACK/1    Release: 2.3
  572. C---------------------------------------------------------
  573.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  574.      +                MAXICH
  575.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  576.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  577.      +          MAXICH
  578.  
  579.         SAVE /TOKENS/
  580.  
  581. C
  582. C TOKTYP = array of token types for current statement
  583. C TOKLEN = parallel array of lengths of associated text strings
  584. C TXTPTR = parallel array of pointers into ISTMG character array of text
  585. C TOKEN = Current token number within statement being processed
  586. C NTOKSS = Number of tokens in statement
  587. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  588. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  589. C MAXICH = Last character used in ISTTXT array
  590. C
  591. C---------------------------------------------------------
  592. C    TOOLPACK/1    Release: 2.3
  593. C---------------------------------------------------------
  594.         COMMON/ANVNAM/VNAMEG
  595.         CHARACTER*5 VNAMEG
  596.         SAVE/ANVNAM/
  597. C---------------------------------------------------------
  598. C    TOOLPACK/1    Release: 2.4
  599. C---------------------------------------------------------
  600. C
  601. C  TKLAST = LAST TOKEN NUMBER
  602. C
  603.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  604.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  605.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  606.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  607.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  608.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  609.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  610.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  611.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  612.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  613.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  614.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  615.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  616.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  617.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  618.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  619.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  620.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  621.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  622.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  623.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  624.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  625.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  626.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  627.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  628.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  629.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  630.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  631.  
  632.  
  633.         IF (.NOT.BLKDTG) THEN
  634.             IF (TOKTYP(1).EQ.TDCNST) THEN
  635.                 CALL SENDTK(1,1)
  636.             ELSE
  637.                 CALL SENDCH('      ')
  638.             END IF
  639.             IF (TRACEG) THEN
  640.                 CALL SENDCH('CALL T'//VNAMEG//'(')
  641.                 CALL SENDI(NMSEGA)
  642.                 CALL SENDCH(')')
  643.             ELSE
  644.                 CALL SENDCH('I'//VNAMEG//'(')
  645.                 CALL SENDI(NMSEGA)
  646.                 CALL SENDCH(')=I'//VNAMEG//'(')
  647.                 CALL SENDI(NMSEGA)
  648.                 CALL SENDCH(')+1')
  649.             END IF
  650.             CALL SEND
  651.         END IF
  652.  
  653.         END
  654. C ----------------------------------------------------------------------
  655. C
  656. C       P A I F S   -   Process arithmetic IF statements
  657. C
  658.  
  659.         SUBROUTINE PAIFS(NTOKA,NTOK2A)
  660.         INTEGER NTOKA,NTOK2A
  661.  
  662. C---------------------------------------------------------
  663. C    TOOLPACK/1    Release: 2.3
  664. C---------------------------------------------------------
  665. C                  LOGICAL VARIABLES
  666.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  667.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  668.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  669.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  670.      *         TREEG
  671.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  672.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  673.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  674.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  675.  
  676.         SAVE /LOGIC/
  677.  
  678. C---------------------------------------------------------
  679. C    TOOLPACK/1    Release: 2.3
  680. C---------------------------------------------------------
  681. C                  CONTROL VARIABLES
  682.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  683.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  684.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  685.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  686.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  687.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  688.      *         NSTMG,       NTREEG,      NTYPEG
  689.  
  690.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  691.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  692.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  693.      +          NTREEG,NTYPEG
  694.  
  695.         SAVE /CNTRLC/
  696.  
  697. C---------------------------------------------------------
  698. C    TOOLPACK/1    Release: 2.3
  699. C---------------------------------------------------------
  700. C                  ROUTINE INSTRUMENTATION FLAGS
  701.       COMMON / INSTC   /    INST1G,      INST2G,      INST3G
  702.  
  703.         INTEGER INST1G,INST2G,INST3G
  704.  
  705.         SAVE /INSTC/
  706.  
  707. C---------------------------------------------------------
  708. C    TOOLPACK/1    Release: 2.3
  709. C---------------------------------------------------------
  710. C                  MAIN INTEGER STORAGE ARRAYS
  711. C MAXLBG = Maximum number of DO statement labels per routine
  712.         INTEGER MAXLBG
  713.         PARAMETER(MAXLBG=100)
  714.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  715.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  716.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  717.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  718.      +          KEXECG,LABG,KTOKG
  719.         SAVE /WORKC/
  720. C---------------------------------------------------------
  721. C    TOOLPACK/1    Release: 2.3
  722. C---------------------------------------------------------
  723.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  724.      +                MAXICH
  725.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  726.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  727.      +          MAXICH
  728.  
  729.         SAVE /TOKENS/
  730.  
  731. C
  732. C TOKTYP = array of token types for current statement
  733. C TOKLEN = parallel array of lengths of associated text strings
  734. C TXTPTR = parallel array of pointers into ISTMG character array of text
  735. C TOKEN = Current token number within statement being processed
  736. C NTOKSS = Number of tokens in statement
  737. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  738. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  739. C MAXICH = Last character used in ISTTXT array
  740. C
  741. C---------------------------------------------------------
  742. C    TOOLPACK/1    Release: 2.4
  743. C---------------------------------------------------------
  744. C
  745. C  TKLAST = LAST TOKEN NUMBER
  746. C
  747.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  748.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  749.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  750.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  751.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  752.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  753.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  754.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  755.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  756.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  757.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  758.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  759.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  760.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  761.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  762.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  763.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  764.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  765.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  766.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  767.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  768.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  769.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  770.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  771.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  772.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  773.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  774.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  775.  
  776.  
  777.         CHARACTER*5 SEGNUM(4)
  778.  
  779.         ARITHG = .TRUE.
  780.         INST1G = 1
  781. C Output segment for test portion, if required
  782.         IF (SEGMTG) THEN
  783.             IF (LABFLG.NE.2) CALL OUTSGS(NMSEG)
  784.             WRITE(SEGNUM(1),9000) NMSEG
  785.         ELSE
  786.             SEGNUM(1)=' '
  787.         END IF
  788. C Output summary file records for prior segment and first two branch
  789. C segments. Ensure 'IF' counted with segment prior to first branch
  790.         ISCNTG(ITYPEG) = ISCNTG(ITYPEG) + 1
  791.         SEGMTG = .FALSE.
  792.         CALL SEGMTS(.TRUE.)
  793.         SEGMTG = .FALSE.
  794.         CALL SEGMTS(.TRUE.)
  795.         SEGMTG = .FALSE.
  796.         CALL SEGMTS(.TRUE.)
  797.         ISCNTG(ITYPEG) = ISCNTG(ITYPEG) - 1
  798. C Build arithmetic 'IF' in buffer
  799.         CALL PAIF2S(NTOKA,NTOK2A)
  800. C Output instrumented statement
  801.         CALL SEND
  802. C Output annotated statement
  803.         WRITE(SEGNUM(2),9000) NMSEG-2
  804.         WRITE(SEGNUM(3),9000) NMSEG-1
  805.         WRITE(SEGNUM(4),9000) NMSEG
  806.         CALL WRITOK(TCMMNT,'*$AN$'//SEGNUM(1)//'      '//SEGNUM(2)//
  807.      +              ' '//SEGNUM(3)//' '//SEGNUM(4))
  808.         CALL OUTANS(0)
  809.  
  810. 9000    FORMAT(SS,I5)
  811.         END
  812. C ----------------------------------------------------------------------
  813. C
  814. C       P A I F 2 S   -   Build arithmetic 'IF' in buffer
  815. C
  816.  
  817.         SUBROUTINE PAIF2S(NTOKA,NTOK2A)
  818.         INTEGER NTOKA,NTOK2A
  819.  
  820. C---------------------------------------------------------
  821. C    TOOLPACK/1    Release: 2.3
  822. C---------------------------------------------------------
  823. C                  CONTROL VARIABLES
  824.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  825.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  826.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  827.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  828.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  829.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  830.      *         NSTMG,       NTREEG,      NTYPEG
  831.  
  832.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  833.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  834.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  835.      +          NTREEG,NTYPEG
  836.  
  837.         SAVE /CNTRLC/
  838.  
  839. C---------------------------------------------------------
  840. C    TOOLPACK/1    Release: 2.3
  841. C---------------------------------------------------------
  842. C                  KEYWORD ID VARIABLES
  843.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  844.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  845.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  846.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  847.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  848.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  849.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  850.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  851.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  852.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  853.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  854.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  855.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  856.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  857.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  858.      *         LLINEG,      LSTMTG
  859.  
  860.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  861.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  862.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  863.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  864.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  865.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  866.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  867.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  868.         INTEGER KUFUNG,KSUBRG
  869.  
  870.         SAVE /KEYSC/
  871.  
  872. C---------------------------------------------------------
  873. C    TOOLPACK/1    Release: 2.3
  874. C---------------------------------------------------------
  875.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  876.      +                MAXICH
  877.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  878.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  879.      +          MAXICH
  880.  
  881.         SAVE /TOKENS/
  882.  
  883. C
  884. C TOKTYP = array of token types for current statement
  885. C TOKLEN = parallel array of lengths of associated text strings
  886. C TXTPTR = parallel array of pointers into ISTMG character array of text
  887. C TOKEN = Current token number within statement being processed
  888. C NTOKSS = Number of tokens in statement
  889. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  890. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  891. C MAXICH = Last character used in ISTTXT array
  892. C
  893. C---------------------------------------------------------
  894. C    TOOLPACK/1    Release: 2.3
  895. C---------------------------------------------------------
  896.         COMMON/ANVNAM/VNAMEG
  897.         CHARACTER*5 VNAMEG
  898.         SAVE/ANVNAM/
  899.  
  900.         INTEGER L
  901.  
  902. C Pack first part of arithmetic 'IF'and set up label field
  903.         IF (LABFLG.EQ.2) THEN
  904.             CALL SENDTK(1,1)
  905.         ELSE
  906.             CALL SENDCH('      ')
  907.         END IF
  908.         CALL SENDCH('IF(A'//VNAMEG//'(0.D0+')
  909. C Pack computational portion of 'IF'
  910.         CALL SENDTK(NTOKA,NTOK2A)
  911. C Pack constants
  912.         CALL SENDCH(',')
  913.         CALL SENDI(NMSEG-2)
  914.         CALL SENDCH(')')
  915. C Pack branch portion of 'IF'
  916.         CALL SENDTK(NTOK2A,NTOKSS)
  917.  
  918.         END
  919. C ----------------------------------------------------------------------
  920. C
  921. C       P A S S 1 S   -   Determine segmentation and instrumentation
  922. C                         of original source code. Input original
  923. C                         source code and output statement type summary
  924. C                         file, annotated listing and a temporary
  925. C                         instrumented program file.
  926. C
  927.  
  928.         SUBROUTINE PASS1S
  929.  
  930. C---------------------------------------------------------
  931. C    TOOLPACK/1    Release: 2.3
  932. C---------------------------------------------------------
  933. C Character variables and arrays, except for dictionaries & VNAMEG
  934.         INTEGER MAXCMG
  935.         PARAMETER(MAXCMG=30)
  936.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  937.  
  938.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  939.         CHARACTER*6 NAMEG
  940.         CHARACTER*72 ICOMG(MAXCMG)
  941.  
  942.         SAVE /CHARC/
  943. C---------------------------------------------------------
  944. C    TOOLPACK/1    Release: 2.3
  945. C---------------------------------------------------------
  946. C                  LOGICAL VARIABLES
  947.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  948.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  949.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  950.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  951.      *         TREEG
  952.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  953.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  954.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  955.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  956.  
  957.         SAVE /LOGIC/
  958.  
  959. C---------------------------------------------------------
  960. C    TOOLPACK/1    Release: 2.3
  961. C---------------------------------------------------------
  962. C                  CONTROL VARIABLES
  963.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  964.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  965.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  966.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  967.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  968.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  969.      *         NSTMG,       NTREEG,      NTYPEG
  970.  
  971.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  972.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  973.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  974.      +          NTREEG,NTYPEG
  975.  
  976.         SAVE /CNTRLC/
  977.  
  978. C---------------------------------------------------------
  979. C    TOOLPACK/1    Release: 2.3
  980. C---------------------------------------------------------
  981. C                  KEYWORD ID VARIABLES
  982.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  983.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  984.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  985.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  986.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  987.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  988.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  989.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  990.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  991.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  992.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  993.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  994.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  995.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  996.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  997.      *         LLINEG,      LSTMTG
  998.  
  999.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  1000.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  1001.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  1002.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  1003.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  1004.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  1005.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  1006.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  1007.         INTEGER KUFUNG,KSUBRG
  1008.  
  1009.         SAVE /KEYSC/
  1010.  
  1011. C---------------------------------------------------------
  1012. C    TOOLPACK/1    Release: 2.3
  1013. C---------------------------------------------------------
  1014. C                  MAIN INTEGER STORAGE ARRAYS
  1015. C MAXLBG = Maximum number of DO statement labels per routine
  1016.         INTEGER MAXLBG
  1017.         PARAMETER(MAXLBG=100)
  1018.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1019.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1020.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1021.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1022.      +          KEXECG,LABG,KTOKG
  1023.         SAVE /WORKC/
  1024.  
  1025. C Pass 1 input loop:
  1026. C Read an entire statement
  1027.   100   CALL READSS
  1028.         IF (.NOT.IEOFG) THEN
  1029.             IF (ISTMG(1).EQ.'*') THEN
  1030. C Assertion statement being processed
  1031.                 CALL ASSRTS
  1032.             ELSE
  1033. C Normal statement being processed
  1034.                 NBUFFG = 0
  1035.                 LTYPEG = ITYPEG
  1036.                 CALL TYPES(1,ITYPEG,NTOKG,NTOK2G)
  1037.                 IF (ITYPEG .EQ. KLIFG)
  1038.      +              CALL TYPES(NTOK2G+1,IFTYPG,NTOK3G,NTOK4G)
  1039.                 CALL PROCES
  1040.                 CALL COUNTS(ITYPEG)
  1041. C Start segment after certain statements
  1042.                 IF (ITYPEG.EQ.KCGOG .OR. ITYPEG.EQ.KDOG .OR.
  1043.      +              ITYPEG.EQ.KBIFG .OR. ITYPEG.EQ.KAIFG .OR.
  1044.      +              ITYPEG.EQ.KLIFG .OR. ITYPEG.EQ.KELSFG .OR.
  1045.      +              LABFLG.EQ.2) THEN
  1046.                     SEGMTG = .FALSE.
  1047.                     CALL SEGMTS(.TRUE.)
  1048.                 END IF
  1049.             END IF
  1050.             IF (.NOT.IEOFG) GOTO 100
  1051.         END IF
  1052.         CALL DMPCMS
  1053.         IABEG(NRTNG+1) = NMASRG + 1
  1054.         ISBEG(NRTNG+1) = NMSEG + 1
  1055. C Print message if no 'STOP' found
  1056.         IF (.NOT.STOPG) CALL ERRORS(9)
  1057. C Check for abnormal source program end
  1058.         IF (ITYPEG.NE.KENDG) THEN
  1059.             CALL RDONES
  1060.             CALL ERRORS(20)
  1061.         END IF
  1062.  
  1063.         END
  1064. C ----------------------------------------------------------------------
  1065. C
  1066. C       P A S S 2 S  - Add instrumentation at program level, including
  1067. C                      common blocks to user routines and extra routines
  1068. C                      required for monitoring and output functions.
  1069. C
  1070.  
  1071.         SUBROUTINE PASS2S
  1072.  
  1073. C---------------------------------------------------------
  1074. C    TOOLPACK/1    Release: 2.3
  1075. C---------------------------------------------------------
  1076. C                  CONTROL VARIABLES
  1077.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1078.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1079.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1080.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1081.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1082.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1083.      *         NSTMG,       NTREEG,      NTYPEG
  1084.  
  1085.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1086.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1087.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1088.      +          NTREEG,NTYPEG
  1089.  
  1090.         SAVE /CNTRLC/
  1091.  
  1092. C---------------------------------------------------------
  1093. C    TOOLPACK/1    Release: 2.3
  1094. C---------------------------------------------------------
  1095. C Filenames
  1096.         COMMON/ANFNAM/IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
  1097.         CHARACTER*81 IHSTFN,OHSTFN,LSTFN,ITRAFN,OTRAFN,RUNFN
  1098.         SAVE /ANFNAM/
  1099. C---------------------------------------------------------
  1100. C    TOOLPACK/1    Release: 2.3
  1101. C---------------------------------------------------------
  1102.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1103.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1104.  
  1105.         SAVE /IO/
  1106.  
  1107. C---------------------------------------------------------
  1108. C    TOOLPACK/1    Release: 2.3
  1109. C---------------------------------------------------------
  1110. C                  LOGICAL VARIABLES
  1111.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  1112.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  1113.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  1114.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1115.      *         TREEG
  1116.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1117.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1118.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1119.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1120.  
  1121.         SAVE /LOGIC/
  1122.  
  1123. C---------------------------------------------------------
  1124. C    TOOLPACK/1    Release: 2.3
  1125. C---------------------------------------------------------
  1126. C Option Settings
  1127.         COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
  1128.      +                 MTREQG,TIEG,ITRUNG
  1129.  
  1130.         INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
  1131.      +          ITRUNG
  1132.         LOGICAL TIEG
  1133.  
  1134.         SAVE /OPTSC/
  1135.  
  1136. C---------------------------------------------------------
  1137. C    TOOLPACK/1    Release: 2.3
  1138. C---------------------------------------------------------
  1139.         COMMON/ANVNAM/VNAMEG
  1140.         CHARACTER*5 VNAMEG
  1141.         SAVE/ANVNAM/
  1142. C---------------------------------------------------------
  1143. C    TOOLPACK/1    Release: 2.3
  1144. C---------------------------------------------------------
  1145. C                  MAIN INTEGER STORAGE ARRAYS
  1146. C MAXLBG = Maximum number of DO statement labels per routine
  1147.         INTEGER MAXLBG
  1148.         PARAMETER(MAXLBG=100)
  1149.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1150.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1151.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1152.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1153.      +          KEXECG,LABG,KTOKG
  1154.         SAVE /WORKC/
  1155.  
  1156.         INTEGER CLEN,IRTNL
  1157.  
  1158.         CHARACTER*72 CARD
  1159.  
  1160.         INTEGER ZGETLN
  1161.         EXTERNAL SEEK,ZGETLN
  1162.  
  1163.         CALL SEEK(0,IODSCR)
  1164.         IF (NMSEG.GT.0 .AND. NRTNG.GT.0) THEN
  1165.             IF (ASSRTG .AND. NMASRG.EQ.0) ASSRTG=.FALSE.
  1166. C Move instrumentation from scratch to final file
  1167.  100        CLEN=ZGETLN(CARD,IODSCR)
  1168.             IF (CLEN.EQ.-100) GOTO 110
  1169.             IF (CLEN.LT.5) CARD(CLEN+1:5)=' '
  1170.             IF (CARD(1:2).EQ.'$ ') THEN
  1171. C Instrumentation marker found. Insert required common
  1172. C blocks and add special function type declarations,
  1173. C if routine flags indicate functions used.
  1174.                 CALL WCOMNS
  1175.                 READ(CARD(3:5),9000) IRTNL
  1176.                 IF (ARITHG .AND. INSTG(IRTNL).GE.4)
  1177.      +            CALL OUTMSG('      DOUBLE PRECISION A'//VNAMEG,IODINS)
  1178.                 IF (CGOTOG .AND. MOD(INSTG(IRTNL),4).GE.2)
  1179.      +            CALL OUTMSG('      INTEGER K'//VNAMEG,IODINS)
  1180.                 IF (IFDOG .AND. MOD(INSTG(IRTNL),2).EQ.1)
  1181.      +            CALL OUTMSG('      LOGICAL L'//VNAMEG,IODINS)
  1182.             ELSE
  1183. C Output this statement
  1184.                 CALL OUTMSG(CARD(1:CLEN),IODINS)
  1185.             END IF
  1186.             GOTO 100
  1187. C Output additional instrumenting routines.
  1188. C Arithmetic IF function
  1189.   110       IF (ARITHG) CALL WARTHS
  1190. C BLOCK DATA
  1191.             CALL WBLOKS
  1192. C Computed GOTO function
  1193.             IF (CGOTOG) CALL WGOTOS
  1194. C Logical IF function
  1195.             IF (IFDOG) CALL WIFDOS
  1196. C Assertion monitoring routine
  1197.             IF (ASSRTG) CALL WASRTS
  1198. C History input/output routines
  1199.             IF (HISTG) THEN
  1200.                 CALL WHINS
  1201.                 CALL WHOUTS
  1202.             ELSE IF (RUNFN.NE.' ' .OR. ITRUNG.NE.0) THEN
  1203.                 CALL WHOUTS
  1204.             END IF
  1205. C Line count routine
  1206.             CALL WLINES
  1207. C Wrapup control routine
  1208.             CALL WRAPS
  1209. C Assertion/segment report routine
  1210.             CALL WREPTS
  1211. C Trace input/output routines
  1212.             IF (TRACEG) THEN
  1213.                 CALL WTBUFS
  1214.                 CALL WTINS
  1215.                 CALL WTOUTS
  1216.             END IF
  1217.         END IF
  1218.  
  1219. 9000    FORMAT(BN,I3)
  1220.         END
  1221.